# Read and write map description files.

package require Iexpect
package require Iarray
package require MapExpect

# Parser.
itcl::class Parser {
	proc mention {error} {
		puts "Error: $error"
		return 0
	}
	proc locate {I} {
		return "for map line [$I get line_nr]: [$I get output]"
	}
	proc extract {errorInfo} {
		lindex [split [dict get $errorInfo "-errorinfo"] "\n"] 0
	}
	proc point {location error} {
		mention "$error $location"
	}
	proc except {I error} {
		point [locate $I] $error
	}
	proc stare {I} {
		mention "Map line [$I get line_nr] unrecognized: [$I get output]"
	}
	
	proc fileCheck {fileName hasToExist} {
		if {$hasToExist && ![file exists $fileName]} {
			return [mention "File does not exist: $fileName"]
		}
		return 1
	}

	constructor {name {alias ""}} {
		set iMap [iarray::code [Map #auto $name $alias]]
	}
	destructor {
		itcl::delete object $iMap
	}

	method getMap {} {return $iMap}
	
	method getInDir {} {return $iInDir}
	method setInDir {dir} {set iInDir $dir}
	method getOutDir {} {return $iOutDir}
	method setOutDir {dir} {set iOutDir $dir}
	method getFileEncoding {} {return $iFileEncoding}
	method setFileEncoding {fileEncoding} {set iFileEncoding $fileEncoding}
		
	method read {} {
		error "No read method yet for [$this info class]"
	}
	method write {dir} {
		error "No write method yet for [$this info class]"
	}
	
	variable iMap
	variable iInDir {}
	variable iOutDir {}
	variable iFileEncoding "iso8859-1"
}

# DPParser. For parsing DPjudge style map files.
itcl::class DPParser {
	inherit Parser
	
	constructor {name {alias ""}} {
		Parser::constructor $name $alias
	} {}
	
	method read {} {
		readMapFile "[$iMap get name].map"
	}
	
	method readMapFile {mapFileName} {
		set variant ""
		set power ""
		
		set provinces [$iMap getProvinces]
		set coastalAreas {}
		set adjacencies [$iMap getAdjacencies]
		set army [[$iMap getUnitTypes] match initial A]
		set fleet [[$iMap getUnitTypes] match initial F]
		
		set mapFileSpec [file join $iInDir $mapFileName]
		if {![fileCheck $mapFileSpec 1]} {return 0}
		
		set I [iarray::code [MapExpect #auto -file $mapFileSpec -nocase -white -encoding $iFileEncoding]]
		
		$I expect line "^($|#)" {
			$I continue
		} "^(rule|notify|rotate|victory|flow|begin|tax|cap) " {
			$iMap addDirectives [list [$I get output] $variant]
			$I continue
		} "^(owns|home|league) " {
			if {![string length $power]} {
				except $I "No power selected"
			} else {
			}
			$I continue
		} "^control " {
			if {![string length $power]} {
				except $I "No power selected"
			} else {
			}
			$I continue
		} "^league " {
			if {![string length $power]} {
				except $I "No power selected"
			} else {
			}
			$I continue
		} "^(dummy|unplayed)($| )" {
			$I continue
		} "^unowned " {
			$I continue
		} "^directives($| )" {
			set variant [string toupper [$I get unchecked]]
			$I continue
		} "^end directives$" {
			set variant ""
			$I continue
		} "^drop " {
			$I continue
		} "^(\\w+) (\\w+) abuts " {
			if {[catch {$provinces matchOne [$I get match 2]}] province errorInfo} {
				except $I [extract $errorInfo]
			} else {
				set unitTypes [list $army]
				switch [string tolower [$I get match 1]] "shut" {
					$province setTerrainType 0
					set unitTypes [list $army]
				} "land" {
					$province setTerrainType 1
					set unitTypes [list $army]
				} "water" {
					$province setTerrainType 2
					set unitTypes [list $fleet]
				} "coast" {
					$province setTerrainType 3
					set unitTypes [list $army $fleet]
				} "port" {
					$province setTerrainType 4
					set unitTypes [list $army $fleet]
				} "ice" {
					$province setTerrainType 5
					set unitTypes [list $fleet]
				} default {
					except $I "Unknown terrain type"
				}
				foreach destination [$I get unmatched] {
					regexp "^(.*)\\((.*)\\)?[~*]?$" $destination match destination centers strength
					switch $strength "" {
						set strength 10
					} "~" {
						set strength 0
					} "*" {
						set strength 5
					}
					set ownedCenters {}
					foreach center [split $centers ","] {
						if {[catch {$provinces matchOne [string trim $center]}] ownedCenter errorInfo} {
								except $I [extract $errorInfo]
						} else {
							lappend ownedCenters $ownedCenter
						}
					}
					if {[catch {$provinces matchOne $destination}] adjacent errorInfo} {
						except $I [extract $errorInfo]
					} else {
						switch 
						for unitType {$army $fleet} {
							set adjacency [Adjacency #auto $army $adjacent $province]
							set found [$adjacencies find $adjacency]
							if {[string length $found]} {
								if {[$found getStrength] != $strength} {
									except $I "Strength in other direction is [$found getStrength]"
								}
								
								itcl::delete object $adjacency
							}
						}
					}
				}
			}
			$I continue
		} " -> (\[^=\]+) = " {
			set oldAlias [string trim [$I get unmatched]]
			set alias [lindex [$I get unchecked] 0]
			set longName [string trim [$I get match 1]]
			set alternatives [IdentityList::lapply [lrange [$I get unchecked] 1 end] {regsub -all "\\\+"} " "]
			set splits [CompositeIdentity::split $oldAlias]
			if {[llength $splits] < 2} {
				set matches [$provinces match $oldAlias all 0]
				if {![llength $matches]} {
					set matches [$provinces match $oldAlias]
				}
				if {![llength $matches]} {
					except $I "Old alias not found"
				} else {
					set province [lindex $matches 0]
					$province addTranslation $longName $alias $alternatives
				}
			} else {
				set oldCoastAlias [lindex $splits 1]
				set splits [CompositeIdentity::split $alias]
				set nameSplits [CompositeIdentity::split $longName]
				if {([llength $splits] < 2) || ([llength $nameSplits] < 2)} {
					except $I "Renamed coastal area should retain coast"
				}
				if {[catch {$iMap addCoast [lindex $nameSplits 1] [lindex $splits 1] $oldCoastAlias} coast errorInfo]} {
					except $I [extract $errorInfo]
				}
				# As coastal areas are only added at the end of this routine,
				# we don't bother checking whether this province exists or has this coast.
			}
			$I continue
		} " = " {
			set alias [lindex [$I get unchecked] 0]
			set longName [string trim [$I get unmatched]]
			set alternatives [IdentityList::lapply [lrange [$I get unchecked] 1 end] {regsub -all "\\\+"} " "]
			if {[llength [$provinces match $alias all 0]]} {
				except $I "Province alias already defined"
			} elseif {[llength [$provinces match $longName all 0]]} {
				except $I "Province name already defined"
			} else {
				set splits [CompositeIdentity::split $alias]
				if {[llength $splits] < 2} {
					if {[catch {$provinces add [iarray::code [Province #auto $longName $alias $alternatives]]} province errorInfo]} {
						except $I [extract $errorInfo]
					}
				} else {
					set nameSplits [CompositeIdentity::split $longName]
					if {[llength $nameSplits] < 2} {
						except $I "Province name lacks coast found in alias"
					} else {
						if {[catch {$iMap addCoast [lindex $nameSplits 1] [lindex $splits 1]} coast errorInfo]} {
							except $I [extract $errorInfo]
						} else {
							# As coastal areas are sometimes defined before the main province,
							# we'll add them after having parsed everything.
							lappend coastalAreas [lindex $nameSplits 0] [lindex $splits 0] $coast [locate $I]
						}
					}
					# We don't bother going through the alternatives. In many cases they are incomplete.
					# They may however list an alternative coast alias (e.g. spa/ec as an alternative for spa/sc in standard),
					# which unfortunately will be ignored. This however hardly ever happens, and simply complicates things.
				}
			}
			$I continue
		} " -> (\[^ \]+) \\\(\[^):\]*(:.*)?\\\)" {
			$I continue
		} " \\\(\[^):\]*(:.*)?\\\)" {
			$I continue
		} "^(\\S \\S+)$" {
			$I continue
		} "^(\\S+)$" {
			$I continue
		} default {
			stare $I
			$I continue
		}
		
		itcl::delete object $I
		
		foreach {longName alias coast location} $coastalAreas {
			set matches [$provinces match $alias alias 0]
			if {![llength $matches]} {
				point $location "Main province not defined"
			} else {
				set province [lindex $matches 0]
				if {![llength [$province match $longName name 0]]} {
					point $location "Main province alias differs from name"
				}
				$province addCoast $coast
			}
		}
		
		return 1
	}
}

# KLParser. For parsing Ken Lowe judge (now called Njudge) style map files.
itcl::class KLParser {
	inherit Parser
	
	constructor {name {alias ""}} {
		Parser::constructor $name $alias
	} {}
	
	
	method read {} {
		readMapFile "map.[$iMap get name]"
	}
	
	method readMapFile {mapFileName} {
		set provinces [$iMap getProvinces]

		set mapFileSpec [file join $iInDir $mapFileName]
		if {![fileCheck $mapFileSpec 1]} {return 0}
		
		set I [iarray::code [iexpect::Expect #auto -file $mapFileSpec -nocase -white -encoding $iFileEncoding]]
		
		$I expect line "^($|#)" {
			$I continue
		} "^-1$" {
			# End of this section
		} ", ?(\\w)(w?) " {
			set alias [lindex [$I get unchecked] 0]
			set longName [string trim [$I get unmatched]]
			set alternatives [lrange [$I get unchecked] 1 end]
			if {[llength [$provinces match $alias all 0]]} {
				except $I "Province alias already defined"
			} elseif {[llength [$provinces match $longName all 0]]} {
				except $I "Province name already defined"
			} else {
				if {[catch {$provinces add [iarray::code [Province #auto $longName $alias $alternatives]]} province errorInfo]} {
					except $I [extract $errorInfo]
				} else {
					if {[string is upper [$I get match 1]]} {
						$province setTerrainType 1
						$province setSupplyType 1
					} else {
						switch [$I get match 1] l {
							$province setTerrainType 1
						} w {
							$province setTerrainType 2
						} x {
							$province setTerrainType 1
							$province setSupplyType 1
						} v {
							$province setTerrainType 5
						} default {
							except $I "Unknown terrain type"
						}
					}
					if {[string length [$I get match 2]]} {
						if {[$provinces getTerrainType] == 1} {
							$province setTerrainType 4
						} else {
							except $I "Non-land province can't be port"
						}
					}
				}
			}
			$I continue
		} default {
			stare $I
			$I continue
		}

		$I expect line "^($|#)" {
			$I continue
		} "^-1$" {
			# End of this section
		} "-(\\w\\w): " {
			$I continue
		} default {
			stare $I
			$I continue
		}

		itcl::delete object $I
		
		return 1
	}
}

# RPParser. For parsing Realpolitik style map files.
itcl::class RPParser {
	inherit KLParser
	
	constructor {name {alias ""}} {
		KLParser::constructor $name $alias
	} {}
	
	method read {} {
		readMapFile "[$iMap get name].map"
	}
}

# MMParser. For parsing MapMaker style map files.
itcl::class MMParser {
	inherit Parser
	
	constructor {name {alias ""}} {
		Parser::constructor $name $alias
	} {}
	
	method read {} {
		readMakerFile "[$iMap get name].mkr"
	}
	
	method readMakerFile {mapFileName} {
		set provinces [$iMap getProvinces]

		set mapFileSpec [file join $iInDir $mapFileName]
		if {![fileCheck $mapFileSpec 1]} {return 0}
		
		set I [iarray::code [iexpect::Expect #auto -file $mapFileSpec -encoding $iFileEncoding]]
		
		set break 0
		set item ""
		proc attempt {next} {
			upvar item itemPtr
			uplevel {
				if {$break} {
					switch $break 1 {
						except $I "$item line mismatched"
					} 2 {
						mention "$item line missing"
					}
					itcl::delete object $I
					return -level 2
				}
			}
			set itemPtr $next
		}
		
		$I expect after default {
			set break 1
		} eof {
			set break 2
		}
		# May be preceded by mail headers, etc.
		attempt "Mapmaker Data File"
		$I expect line "^Mapmaker Data File$" {
		} default {
			$I continue
		}
		attempt "MapMaker version"
		$I expect line "^\\d$" {
			# First digit: MapMaker version?
		}
		
		# The next number tells how many provinces there are.
		attempt "Number of provinces"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		} 

		for {set l 0} {$l < $len} {incr l} {
			attempt "X coordinate for province"
			$I expect line "^(-?\\d+)$" {
			}
			attempt "Y coordinate for province"
			$I expect line "^(-?\\d+)$" {
			}
			attempt "Province name"
			set longName ""
			$I expect line default {
				set longName [string trim [$I get output]]
			}
			attempt "Province alias"
			set alias ""
			$I expect line default {
				set alias [string trim [$I get output]]
			}
			# MapMaker allows a name to not be filled in. E.g. spaces "X" and "Y" in MEDITERR.MKR.
			if {![string length $longName]} {
				if {![string length $alias]} {
					except $I "Missing province name and alias"
				} else {
					set longName $alias
				}
			} elseif {![string length $alias]} {
				set alias $longName
			}
			set province ""
			if {[string length $alias]} {
				if {[llength [$provinces match $alias all 0]]} {
					except $I "Province alias already defined"
				} elseif {[llength [$provinces match $longName all 0]]} {
					except $I "Province name already defined"
				} else {
					if {[catch {$provinces add [iarray::code [Province #auto $longName $alias]]} province errorInfo]} {
						except $I [extract $errorInfo]
					}
				}
			}
			attempt "Supply center"
			$I expect line "^(\\d)$" {
				# First digit: 0: No supply center; 1: Supply center
				if {[$I get match 1]} {
					$province setSupplyType 1
				}
			}
			attempt "Terrain type"
			$I expect line "^(\\d)$" {
				# Second digit: 0: Land; 1: Water; 2: Canal; 3: Shut
				switch [$I get match 1] 0 {
					$province setTerrainType 1
				} 1 {
					$province setTerrainType 2
				} 2 {
					$province setTerrainType 1
				} 3 {
					$province setTerrainType 0
				} default {
					except $I "Unknown terrain type"
				}
			}
			attempt "Edge of map"
			$I expect line "^(\\d)$" {
				# Third digit: 0: Normal 1: Edge 2: Portugal (makes adjacent sea touch both coasts of adjacent multi-coast)
				# The next two numbers indicate the position on the map.
			}
		}
		
		# Adjacencies
		attempt "Number of adjacencies"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		}
		puts $len
		for {set l 0} {$l < $len * 2} {incr l} {
			attempt "Adjacency"
			$I expect line default {}
		}
		
		# Powers
		attempt "Number of powers"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		}
		puts $len
		for {set l 0} {$l < $len * 4} {incr l} {
			attempt "Power"
			$I expect line default {}
		}
		
		# Units
		attempt "Number of units"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		}
		puts $len
		for {set l 0} {$l < $len * 3} {incr l} {
			attempt "Unit"
			$I expect line default {}
		}

		# The next lines contain the variant name and the authors. We skip those.
		# Then come the credits, preceded by a number indicating the number of lines the credits take up.
		attempt "Number of credits"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		} default {
			$I continue
		}
		puts $len
		for {set l 0} {$l < $len} {incr l} {
			attempt "Credit"
			$I expect line default {}
		}
		
		# The next number tells us the number of multi-coast provinces.
		attempt "Number of multi-coast provinces"
		set len 0
		$I expect line "^(\\d+)$" {
			set len [$I get match 1]
		}
		puts $len
		for {set l 0} {$l < $len} {incr l} {
			# First the index of the province.
			attempt "Multi-coast province index"
			set idx -1
			$I expect line "^(\\d+)$" {
				set idx [$I get match 1]
			}
			if {($idx < 0) || ($idx >= [$provinces length])} {
				except $I "Multi-coast province index out of range"
			} else {
				set province [$provinces index $idx]
				# Next for each wind direction the sea that borders it, if any.
				foreach direction {north south east west} {
					attempt "Sea touching $direction coast"
					$I expect line "^$" {
					} default {
						$province addCoast [$iMap addCoast "$direction coast" "[string index $direction 0]c"]
					}
				}
			}
			attempt "Multi-coast province separator"
			$I expect line "^-?\\d+$" {
			} default {
				$I continue
			}
		}
		
		# Make sure we catch an error in the final line.
		attempt ""
		
		itcl::delete object $I
		
		return 1
	}
}

# Translation
itcl::class Translation {
	constructor {name alias {alternatives {}}} {
		set iName $name
		set iAlias $alias
		set iAlternatives $alternatives
	}

	method getName {} {return $iName}
	method getAlias {} {return $iAlias}
	method getAlternatives {} {return $iAlternatives}
	
	method match {name} {
		expr [lsearch -nocase [concat [list $iName $iAlias] $iAlternatives] $name] < 0 ? 0 : 1
	}
	method equal {translation} {
		expr [string equal -nocase $iName [$translation getName]] || [string equal -nocase $iAlias [$translation getAlias]]
	}
	
	variable iName ""
	variable iAlias ""
	variable iAlternatives {}
}

# Identity
itcl::class Identity {
	constructor {name {alias ""} {alternatives {}}} {
		addTranslation $name $alias $alternatives
	}
	destructor {
		foreach translation $iTranslations {
			itcl::delete object $translation
		}
	}

	method addTranslation {name alias {alternatives {}}} {
		set translation [iarray::code [Translation #auto $name $alias $alternatives]]
		lappend iTranslations $translation
		return $translation
	}
	method getTranslation {{id end}} {
		return [lindex $iTranslations $id]
	}
	method getNrOfTranslations {} {
		return [llength $iTranslations]
	}

	method get {{kind all} {id end}} {
		set translation [getTranslation $id]
		switch $kind name {
			$translation getName
		} alias {
			$translation getAlias
		} alternatives {
			$translation getAlternatives
		} default {
			concat [list [$translation getName] [$translation getAlias]] [$translation getAlternatives]
		}		
	}
	method match {name {kind all} {id end}} {
		set matches {}
		switch $kind name {
			if {[string equal -nocase [[getTranslation $id] getName] $name]} {lappend matches $this}
		} alias {
			if {[string equal -nocase [[getTranslation $id] getAlias] $name]} {lappend matches $this}
		} default {
			if {[[getTranslation $id] match $name]} {lappend matches $this}
		}
		return $matches
	}
	method equal {identity {id end}} {[getTranslation $id] equal [$identity getTranslation $id]}
	
	variable iTranslations {}
}

# CompositeIdentity
itcl::class CompositeIdentity {
	
	proc split {name} {
		if {[string equal ")" [string index $name end]]} {
			set subName [string range $name 0 end-1]
			set sep "("
		} else {
			set subName $name
			set sep "/"
		}
		set idx [string last $sep $subName]
		if {$idx < 0} {return [list $name]}
		set name [string trimright [string range $subName 0 [expr $idx - 1]]]
		set subName [string range $subName [expr $idx + 1] end]
		return [list $name $subName] 
	}
	
	constructor {mainIdentity subIdentity} {
		set iMainIdentity $mainIdentity
		set iSubIdentity $subIdentity
	}

	method getMainIdentity {} {return $iMainIdentity}
	method getSubIdentity {} {return $iSubIdentity}

	method get {{kind all} {id end}} {
		set mainTranslation [$iMainIdentity getTranslation $id]
		set subTranslation [$iSubIdentity getTranslation $id]
		switch $kind name {
			return "[$iMainIdentity get name $id] ([$iSubIdentity get name $id])"
		} alias {
			return "[$iMainIdentity get alias $id]/[$iSubIdentity get alias $id]"
		} alternatives {
			set mainName [$iMainIdentity get name $id]
			set subName [$iSubIdentity get name $id]
			set mainAlias [$iMainIdentity get alias $id]
			set subAlias [$iSubIdentity get alias $id]
			set alternatives [list ${mainAlias}($subAlias) $mainName/$subAlias ${mainName}($subAlias)]
			foreach mainAlternative [$iMainIdentity get alternatives $id] {
				lappend alternatives "$mainAlternative/$subAlias" "${mainAlternative}($subAlias)" "${mainAlternative} ($subName)"
			}
			foreach subAlternative [$iSubIdentity get alternatives $id] {
				lappend alternatives "$mainName/$subAlternative" "${mainName} ($subAlternative)" "$mainAlias/$subAlternative" "${mainAlias}($subAlternative)"
				foreach mainAlternative [$iMainIdentity get alternatives $id] {
					lappend alternatives "$mainAlternative/$subAlternative" "${mainAlternative}($subAlternative)" "${mainAlternative} ($subAlternative)"
				}
			}
			return $alternatives
		} default {
			concat [list [get name] [get alias]] [get alternatives]
		}
	}
	method match {name {kind all} {id end}} {
		set splits [split $name]
		if {[llength $splits] < 2} {return 0}
		expr [$iSubIdentity match [lindex $splits 1] $kind $id] && [$iMainIdentity match [lindex $splits 0] $kind $id]
	}
	method equal {compositeIdentity {id end}} {
		expr [$iSubIdentity equal [$compositeIdentity getSubIdentity] $id] && [$iMainIdentity equal [$compositeIdentity getMainIdentity] $id]
	}
	
	variable iMainIdentity
	variable iSubIdentity
}

# IdentityList.
itcl::class IdentityList {
	proc lapply {list op args} {
		set resultList {}
		foreach el $list {
			lappend resultList [uplevel 1 [list eval $op [list $el] $args]]
		}
		return $resultList
	}

	constructor {class {acquired 0}} {
		set iClass $class
		set iAcquired $acquired
	}
	destructor {
		if {$iAcquired} {
			foreach member $iList {
				itcl::delete object $member
			}			
		}
	}
	
	method getList {} {return $iList}
	method getClass {} {return $iClass}
	
	method clear {} {set iList {}}
	method add {item} {
		if {![itcl::is object -class $iClass $item]} {error "$item is not a member of $iClass"}
		set member [find $item]
		if {[string length $member]} {
			if {$iAcquired} {itcl::delete object $item}
			return $member
		} else {
			lappend iList $item
			return $item
		}
	}
	method remove {idx} {
		set member [lindex $iList $idx]
		if {![string length $member]} return
		if {$iAcquired} {itcl::delete object $member}
		set iList [range $iList $idx $idx]
	}
	method index {idx} {lindex $iList $idx}
	method length {} {llength $iList}
	method find {} {
		foreach member $iList {
			if {[$member equal $item]} {
				return $member
			}
		}
		return ""
	}

	method get {{kind all} {id end}} {
		apply get $kind $id
	}
	method match {name {kind all} {id end}} {
		set matches {}
		foreach member $iList {
			eval lappend matches [$member match $name $kind $id]
		}
		return $matches
	}
	method matchOne {name {kind all} {id end}} {
		set matches [match $name $kind $id]
		switch [llength $matches] 0 {
			error "No match for $name in [string tolower $iClass] list"
		} 1 {			
		} default {
			error "More than one match for $name in [string tolower $iClass] list"
		}
		lindex $matches 0
	}
	method equal {identityList} {
		if {![string equal $iClass [$identityList getClass]]} {return 0}
		if {[llength $iList] != [llength [$identityList getList]]} {return 0}
		foreach member $iList ilMember [$identityList getList] {
			if {![$member equal $ilMember]} {return 0}
		}
		return 1
	}
	
	method apply {args} {
		set resultList {}
		foreach member $iList {
			lappend resultList [uplevel 1 [list eval $member $args]]
		}
		return $resultList
	}
	
	variable iList {}
	variable iClass
	variable iAcquired 0
}

# Coast.
itcl::class Coast {
	inherit Identity
	
	constructor {coastName coastAlias} {
		Identity::constructor $coastName $coastAlias
	} {}
}

# Area. Base class.
itcl::class Area {
}

# Province. Main area.
itcl::class Province {
	inherit Area Identity

	constructor {name alias {alternatives {}}} {
		Identity::constructor $name $alias $alternatives
	} {
		set iCoastalAreas [iarray::code [IdentityList #auto CoastalArea 1]]
	}
	destructor {
		itcl::delete object $iCoastalAreas
		chain
	}

	method setTerrainType {terrainType} {set iTerrainType $terrainType}
	method getTerrainType {} {return $iTerrainType}
	
	method setSupplyType {supplyType} {set iSupplyType $supplyType}
	method getSupplyType {} {return $iSupplyType}
	
	method getCoastalAreas {} {return $iCoastalAreas}
	method addCoast {coast} {
		set coastalArea [iarray::code [CoastalArea #auto $this $coast]]
		$iCoastalAreas add $coastalArea
		return $coastalArea
	}

	method match {name {kind all} {id end}} {
		set splits [CompositeIdentity::split $name]
		set matches [chain [lindex $splits 0] $kind $id]
		if {([llength $splits] < 2) || ![llength $matches]} {return $matches}
		set coastName [lindex $splits 1]
		set matches {}
		foreach coastalArea [$iCoastalAreas getList] {
			if {[llength [[$coastalArea getCoast] match $coastName $kind $id]]} {
				lappend matches $coastalArea
			}
		}
		return $matches
	}

	variable iCoastalAreas
	# iTerrainType values:
	#  0: Shut (impassable)
	#  1: Land
	#  2: Water
	#  3: Coast (including canal provinces containing land)
	#  4: Port (coast where convoying through is allowed)
	#  5: Ice
	variable iTerrainType 0
	# iSupplyType values:
	#  0: No SC
	#  1: SC 
	variable iSupplyType 0	
}

# Coastal area.
itcl::class CoastalArea {
	inherit Area CompositeIdentity

	constructor {province coast} {
		CompositeIdentity::constructor $province $coast
	} {
		set iProvince $province
	}
	
	method getProvince {} {return $iProvince}
	method getCoast {} {getSubIdentity}
	
	variable iProvince
}

# Adjacency. Establishes border between areas. Base class.
itcl::class Adjacency {
	constructor {unitType fromArea toArea {bidirectional 0} {strength 10}} {
		set iUnitType $unitType
		set iFromArea $fromArea
		set iToArea $toArea
		set iIsBidirectional $bidirectional
		set iStrength $strength
		set iOwnedCenters [iarray::code [IdentityList #auto Province 1]]
	}
	
	method getUnitType {} {return $iUnitType}
	method setUnitType {unitType} {set iUnitType $unitType}
	
	method getFromArea {} {return $iFromArea}
	method setFromArea {area} {set iFromArea $area}
	
	method getToArea {} {return $iToArea}
	method setToArea {area} {set iToArea $area}
	
	method isBidirectional {} {return $iIsBidirectional}
	method setBidirectional {{bidirectional 1}} {set iIsBidirectional $bidirectional}
	
	method getStrength {} {return $iStrength}
	method setStrength {strength} {set iStrength $strength}
	
	method getOwnedCenters {} {return $iOwnedCenters}
	
	method match {name {kind all} {id end}} {
		concat [$iFromArea match $name $kind $id] [$iToArea match $name $kind $id]
	}
	method equal {adjacency {id end}} {
		expr [$iUnitType equal [$adjacency getUnitType] $id] &&
			(([$iFromArea equal [$adjacency getFromArea] $id] && [$iToArea equal [$adjacency getToArea] $id]) ||
			([$iFromArea equal [$adjacency getToArea] $id] && [$iToArea equal [$adjacency getFromArea] $id]))
	}
	
	method swap {} {
		set area $iFromArea
		set iFromArea $iToArea
		set iToArea $area
	}
		
	variable iUnitType
	variable iFromArea
	variable iToArea
	variable iIsBidirectional 0
	# iStrength values:
	#  0: No strength; no support can be given
	#  5: Half strength; no support can be given
	#  1: Normal strength; support can be given
	variable iStrength 10
	variable iOwnedCenters
}

# UnitType.
itcl::class UnitType {
	inherit Identity
	
	constructor {name {initial ""}} {
		Identity::constructor $name $initial
	} {}
	
	method addTranslation {name {initial ""} {alternatives {}}} {
		if {![string length $initial]} {set initial [string index $name 0]}
		chain $name $initial $alternatives
	}

	method get {{kind all} {id end}} {
		switch $kind initial {
			chain alias $id
		} default {
			chain $kind $id
		}
	}
	method match {name {kind all} {id end}} {
		switch $kind initial {
			chain $name alias $id
		} default {
			chain $name $kind $id
		}
	}
}

# Unit.
itcl::class Unit {
	constructor {type area} {
		set iType $type
		set iArea $area
	}
	
	method getType {} {return $iType}
	method setType {type} {set iType $type}	
	method getArea {} {return $iArea}
	method setArea {area} {set iArea $area}
	
	method match {name {kind all} {id end}} {
		$iArea match $name $kind $id
	}
	method equal {unit {id end}} {$iArea equal [$unit getArea] $id}
		
	variable iType
	variable iArea
}

# Power.
itcl::class Power {
	inherit Identity
	
	constructor {name {initial ""} {adjective ""}} {
		Identity::constructor $name $initial $adjective
	} {
		set iHomeCenters [iarray::code [IdentityList #auto Province]]
		set iOwnedCenters [iarray::code [IdentityList #auto Province]]
		set iUnits [iarray::code [IdentityList #auto Unit 1]]
		set iControllers [iarray::code [IdentityList #auto Power]]
	}
	destructor {
		itcl::delete object $iHomeCenters
		itcl::delete object $iOwnedCenters
		itcl::delete object $iUnits
		itcl::delete object $iControllers
	}
	
	method addTranslation {name {initial ""} {adjective ""}} {
		if {![string length $initial]} {set initial [string index $name 0]}
		if {![string length $adjective]} {set adjective $name}
		chain $name $initial [list $adjective]
	}

	method get {{kind all} {id end}} {
		switch $kind initial {
			chain alias $id
		} adjective {
			lindex [chain alternatives $id] 0
		} default {
			chain $kind $id
		}
	}
	method match {name {kind all} {id end}} {
		switch $kind initial {
			chain $name alias $id
		} adjective {
			lindex [chain $name alternatives $id] 0
		} default {
			chain $name $kind $id
		}
	}

	method getHomeCenters {} {return $iHomeCenters}
	method getOwnedCenters {} {return $iOwnedCenters}
	method getUnits {} {return $iUnits}
	method getControllers {} {return $iControllers}
	
	method isDummy {} {return $iIsDummy}
	method setDummy {{dummy 1}} {set iIsDummy $dummy}
	method getLeague {} {return $iLeague}
	method setLeague {league} {set iLeague $league}

	variable iHomeCenters
	variable iOwnedCenters
	variable iUnits
	variable iControllers
	variable iIsDummy 0
	variable iLeague ""
}

# Map.
itcl::class Map {
	inherit Identity
	
	constructor {name {alias {}}} {
		Identity::constructor $name $alias
	} {
		set iPowers [iarray::code [IdentityList #auto Power 1]]
		set iProvinces [iarray::code [IdentityList #auto Province 1]]
		set iCoasts [iarray::code [IdentityList #auto Coast 1]]
		set iAdjacencies [iarray::code [IdentityList #auto Adjacency 1]]
		set iDirectives [iarray::code [iarray::Array #auto "ALL" {}]]
		set iUnitTypes [iarray::code [IdentityList #auto UnitType 1]]
		$iUnitTypes add [iarray::code [UnitType #auto "army" "A"]]
		$iUnitTypes add [iarray::code [UnitType #auto "fleet" "F"]]
	}
	destructor {
		itcl::delete object $iPowers
		itcl::delete object $iAdjacencies
		itcl::delete object $iProvinces
		itcl::delete object $iCoasts
		itcl::delete object $iDirectives
		itcl::delete object $iUnitTypes
	}

	method addTranslation {name {alias ""} {alternatives {}}} {
		if {![string length $alias]} {set alias $name}
		chain $name $alias $alternatives
	}

	method getPowers {} {return $iPowers}
	method getProvinces {} {return $iProvinces}
	method getCoasts {} {return $iCoasts}
	method getAdjacencies {} {return $iAdjacencies}
	method getUnitTypes {} {return $iUnitTypes}
	
	method addCoast {coastName coastAlias {oldCoastAlias ""}} {
		if {[string length $oldCoastAlias]} {
			set matches [$iCoasts match $oldCoastAlias alias 0]
			if {![llength $matches]} {
				set matches [$iCoasts match $oldCoastAlias]
			}
			if {![llength $matches]} {
				set matches [$iCoasts match $coastAlias]
				if {![llength $matches]} {
					error "Old coast alias not found"
				}
			} else {
				set coast [lindex $matches 0]
				set matches [$coast match $coastAlias]
				if {![llength $matches]} {
					$coast addTranslation $coastName $coastAlias
				}
			}
		} else {
			set matches [$iCoasts match $coastName name 0]
			if {[llength $matches]} {
				set coast [lindex $matches 0]
				if {![llength [$coast match $coastAlias alias 0]]} {
					error "Coast alias differs from previous definition"
				}
			} else {
				set matches [$iCoasts match $coastAlias alias 0]
				if {[llength $matches]} {
					set coast [lindex $matches 0]
					error "Coast name differs from previous definition"
				} else {
					set coast [iarray::code [Coast #auto $coastName $coastAlias]]
					$iCoasts add $coast
				}
			}
		}
		return $coast
	}
	
	method getDirectiveVariants {} {
		return [$iDirectives names]
	}
	method getDirectives {{variant ""}} {
		if {![string length $variant]} {set variant "ALL"}
		return [$iDirectives on $variant {}]
	}
	method addDirectives {directives {variant ""}} {
		if {![string length $variant]} {set variant "ALL"}
		$iDirectives set $variant [concat [$iDirectives on $variant {}] $directives]
	}
	method clearDirectives {{variant ""}} {
		if {![string length $variant]} {set variant "ALL"}
		$iDirectives set $variant {}
	}
	
	variable iPowers
	variable iProvinces
	variable iCoasts
	variable iAdjacencies
	variable iDirectives
}

# Test
set eRootDir "C:/Varia/Diplomacy" 
set eHomeDir "C:/cygwin/home/Mario"

proc test {variant {type "DP"}} {
	global eRootDir eHomeDir
	global parser map provinces
	
	switch [string toupper $type] "DP" {
		# Retrieve the directory from the variants file
		set variantDir ""
		set variantsFile [open "$eRootDir/HGeye/variants/variants"]
		foreach {dir scripts} [read $variantsFile] {
			foreach script $scripts {
				set script [regsub "^!?\\*?" $script ""]
				if {[string equal -nocase $script $variant]} {
					set variantDir $dir
					set variant $script
					break
				}
			}
		}
		close $variantsFile
		if {![string length $variantDir]} {
			set variantDir $variant
			set variant [string tolower $variant]
		}

		set parser [DPParser #auto $variant]
		$parser setInDir "$eRootDir/HGeye/variants/$variantDir"
	} "RP" {
		set parser [RPParser #auto $variant]
		$parser setInDir "$eRootDir/Realpolitik/Variant Files/$variant"
	} "KL" {
		set parser [KLParser #auto $variant]
		# Tcl complains that the link could not be read, because it's not a directory?
		#$parser setInDir "[file link $eRootDir/Njudge.lnk]/data"
		$parser setInDir "$eHomeDir/njudge-1.7.6/data"
	} "MM" {
		set parser [MMParser #auto $variant]
		$parser setInDir "$eRootDir/MapMaker"
	} default {
		error "Unknown parser type <$type>"
	}
	
	$parser read
	
	set map [$parser getMap]
	set provinces [$map getProvinces]
	
	chan configure stdout -encoding [$parser getFileEncoding]
	
	return $parser
}

eval test $argv